home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / roudled / roundled.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  7KB  |  216 lines
  1. {---------------------------------------------------------------}
  2. {             TRoundLed component copyright 1995                       }
  3. {                Martyn Dowsett CIS 100676,1560                   }
  4. {    Please feel free to use this component as you see fit.       }
  5. {    This is my first contribution to Compuserve and hope         }
  6. {    that you will be able to make some use of this component.    }
  7. {    I would appreciate some feedback, positive or negative.      }
  8. {                                                               }
  9. {    NOTE: Please see roundled.txt for other information.         }
  10. {---------------------------------------------------------------}
  11.  
  12.  
  13. unit RoundLed;
  14. {$R ROUNDLED.RES}
  15. interface
  16.  
  17. uses
  18.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  19.   Forms, Dialogs, ExtCtrls;
  20.  
  21. type
  22.     TLedStatus    = (lsOff, lsOn, lsBlink);
  23.  
  24.     TLedOnColors  = (lcSilver, lcRed,    lcLime, lcYellow,
  25.                      lcBlue,   lcFuchsia, lcAqua, lcWhite);
  26.  
  27.     TLedOffColors = (lcBlack, lcMaroon, lcGreen, lcOlive,
  28.                      lcNavy,  lcPurple, lcTeal, lcGray);
  29.  
  30.     TActualColors = array[0..7] of TColor;
  31.  
  32. const
  33.     ActualOnColors: TActualColors = (clSilver, clRed, clLime, clYellow,
  34.                                      clBlue, clFuchsia, clAqua, clWhite);
  35.  
  36.     ActualOffColors: TActualColors = (clBlack, clMaroon, clGreen, clOlive,
  37.                                       clNavy, clPurple, clTeal, clGray);
  38. type
  39.   TRoundLed = class(TCustomControl)
  40.   private
  41.      { Private declarations }
  42.      FLedPiccy: TBitmap;
  43.      FLedTimer: TTimer;
  44.      FLedIsOn: boolean;
  45.      FLedRect: TRect;
  46.      FLedBulbRect: TRect;
  47.  
  48.      FAutoSelectColor: boolean;
  49.      FLedOnColor: TLedOnColors;
  50.      FLedOffColor: TLedOffColors;
  51.      FBlinkRate: word;
  52.      FLedStatus: TLedStatus;
  53.      procedure SetLedOffColor(value: TLedOffColors);
  54.      procedure SetLedOnColor(value: TLedOnColors);
  55.      procedure SetLedStatus(value: TLedStatus);
  56.      procedure SetBlinkRate(value: word);
  57.  
  58.   protected
  59.      { Protected declarations }
  60.      procedure Paint; override;
  61.      procedure WMSize(var Message: TWMSize); message WM_SIZE;
  62.      procedure BlinkTimeLimit(Sender: TObject);
  63.   public
  64.      { Public declarations }
  65.      constructor Create(AOwner: TComponent); override;
  66.      destructor Destroy; override;
  67.   published
  68.      { Published declarations }
  69.      property AutoSelectColor: boolean read FAutoSelectColor write FAutoSelectColor default True;
  70.      property LedOnColor: TLedOnColors read FLedOnColor write SetLedOnColor default lcRed;
  71.      property LedOffColor: TLedOffColors read FLedOffColor write SetLedOffColor default lcMaroon;
  72.      property BlinkRate: word read FBlinkRate write SetBlinkRate default 1000;
  73.      property LedStatus: TLedStatus read FLedStatus write SetLedStatus default lsOff;
  74.   end;
  75.  
  76. procedure Register;
  77.  
  78. implementation
  79. {------------------------------------------------------------------------------}
  80. constructor TRoundLed.Create(AOwner: TComponent);
  81. begin
  82.     inherited Create(AOwner);
  83.     FLedPiccy := TBitmap.Create;
  84.     FLedPiccy.Handle := LoadBitmap(hInstance, 'GENERICLED');
  85.     with FLedRect do
  86.     begin
  87.         Top := 0;
  88.         Left := 0;
  89.         Right := FLedPiccy.Width;
  90.         Bottom := FLedPiccy.Height;
  91.     end;
  92.     {This TRect stores dimensions for 'filament' of LED}
  93.     with FLedBulbRect do
  94.     begin
  95.         Top := 5;
  96.         Left := 5;
  97.         Right := 10;
  98.         Bottom := 10;
  99.     end;
  100.     {Set defaults}
  101.     FAutoSelectColor := True;
  102.     FBlinkRate :=1000;
  103.     Width := FLedPiccy.Width;
  104.     FLedOffColor := lcMaroon;
  105.     FLedOnColor := lcRed;
  106.     FLedStatus := lsOff;
  107.     FLedIsOn := false;
  108.     Height := FLedPiccy.Height;
  109. end;
  110. {------------------------------------------------------------------------------}
  111. destructor TRoundLed.Destroy;
  112. begin
  113.     FLedPiccy.Free;
  114.     if assigned(FLedTimer) then FLedTimer.Free;
  115.     inherited Destroy;
  116. end;
  117. {------------------------------------------------------------------------------}
  118. procedure TRoundLed.Paint;
  119. begin
  120.     Canvas.Brush.Color := (Parent as TForm).Color;
  121.     Canvas.BrushCopy(FLedRect,FLedPiccy, FLedRect, clOlive);
  122.     with Canvas do
  123.     begin
  124.     {Draw colored section of led}
  125.         if FLedIsOn then
  126.             Brush.Color := ActualOnColors[ord(FLedOnColor)]
  127.         else
  128.             Brush.Color := ActualOffColors[ord(FLedOffColor)];
  129.  
  130.         BrushCopy(FLedBulbRect,FLedPiccy, FLedBulbRect, clMaroon);
  131.     end;
  132. end;
  133. {------------------------------------------------------------------------------}
  134. procedure TRoundLed.WMSize(var Message: TWMSize);
  135. begin
  136.     {Keep control the same size as the LED bitmap}
  137.     inherited;
  138.     Width := FLedPiccy.Width;
  139.     Height := FLedPiccy.Height;
  140. end;
  141. {------------------------------------------------------------------------------}
  142. procedure TRoundLed.SetLedOffColor(value: TLedOffColors);
  143. begin
  144.     FLedOffColor := value;
  145.     if FAutoSelectColor then
  146.         FLedOnColor := TLedOnColors(FLedOffColor);
  147.     Invalidate;
  148. end;
  149. {------------------------------------------------------------------------------}
  150. procedure TRoundLed.SetLedOnColor(value: TLedOnColors);
  151. begin
  152.     FLedOnColor := value;
  153.     if FAutoSelectColor then
  154.         FLedOffColor:= TLedOffColors(FLedOnColor);
  155.     Invalidate;
  156. end;
  157. {------------------------------------------------------------------------------}
  158. procedure TRoundLed.SetLedStatus(value: TLedStatus);
  159. begin
  160.     if value <> FLedStatus then
  161.     begin
  162.         if assigned(FLedTimer) then
  163.         begin
  164.             FLedTimer.Free;
  165.             FLedTimer := nil;
  166.         end;
  167.         FLedStatus := value;
  168.         case FLedStatus of
  169.             lsOff:
  170.                 FLedIsOn := false;
  171.             lsOn:
  172.                 FLedIsOn := true;
  173.             lsBlink:
  174.                 begin
  175.                     FLedTimer := TTimer.Create(Self);
  176.                     FLedTimer.Interval := FBlinkRate;
  177.                     FLedTimer.OnTimer := BlinkTimeLimit;
  178.                 end;
  179.         end;
  180.         Invalidate;
  181.     end;
  182. end;
  183. {------------------------------------------------------------------------------}
  184. procedure TRoundLed.BlinkTimeLimit(Sender: TObject);
  185. begin
  186.     {This routine is called when the BlinkTime counter has been reached}
  187.     FLedIsOn := not FLedIsOn;
  188.     with Self.Canvas do
  189.     begin
  190.     {Draw colored section of led}
  191.         if FLedIsOn then
  192.             Brush.Color := ActualOnColors[ord(FLedOnColor)]
  193.         else
  194.             Brush.Color := ActualOffColors[ord(FLedOffColor)];
  195.  
  196. {        Brush.Color := FColorToUse;}
  197.         BrushCopy(FLedBulbRect,FLedPiccy, FLedBulbRect, clMaroon);
  198.     end;
  199. end;
  200. {------------------------------------------------------------------------------}
  201. procedure TRoundLed.SetBlinkRate(value: word);
  202. begin
  203.     if value <> FBlinkRate then
  204.     begin
  205.         FBlinkRate := value;
  206.         if assigned(FLedTimer) then FLedTimer.Interval := FBlinkRate;
  207.     end;
  208. end;
  209. {------------------------------------------------------------------------------}
  210. procedure Register;
  211. begin
  212.   RegisterComponents('SimComponents', [TRoundLed]);
  213. end;
  214.  
  215. end.
  216.